PC-SIG Library 8

home *** CD-ROM | disk | FTP | other *** search

/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 201_300 / disk0214 / cinput.bas < prev next >

Wrap

BASIC Source File | 1970-01-01 | 26.4 KB | 844 lines

4 DEFINT A-W,Y-Z 5 DIM F$(17),FLDN$(17,30),FTY(17,30),FL(17,30),IOPT(30) 6 DIM PROMPT$(30),IFN(30),IFLD(30),IRNFLD(30),NOS(30),ADDFLD(30,6) 7 DIM SUBX(30),SUBY(30),MULX(30),MULY(30),TBLOPT(30),TN(30) 8 DIM TBLFLD(30),XKEY(30),YKEY(30),CMOPT(30),MAXMIN(30,6) 9 DIM KC(30),CFLD(30) 13 DIM L(17),NREC(17) 16 DIM KY(17,30),KEYLIST(17,30) 21 DIM TX(10,10) 35 DIM K$(80) 50 DIM X(6,30) 70 CH = 29 75 PRINT "MEMORY FREE ",FRE(0) 80 GOSUB 52000 100 GOSUB 50000 200 GOTO 10000 500 REM ******* CLS 510 CLS 520 RETURN 10000 REM ******** CUSTOM INPUT PROGRAM ********* 10120 GOSUB 500 10130 HLD = 0 10140 PRINT "******** CUSTOM INPUT PROGRAM INITIAL MENU *********" 10145 PRINT "" 10150 PRINT " 0 - EXIT THE PROGRAM " 10155 PRINT "" 10160 PRINT " 1 - ENTER A NEW INPUT DESCRIPTION " 10165 PRINT "" 10180 PRINT " 2 - READ CUSTOM INPUT DESCRIPTION" 10185 PRINT "" 10200 PRINT " 3 - PRINT CUSTOM INPUT DESCRIPTION ON PAPER " 10210 PRINT "" 10220 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN ********" 10240 GOSUB 60000 10242 IF DT# <0 OR DT#> 3 GOTO 10240 10250 T = DT# 10255 IF T = 0 GOTO 51000 10260 ON T GOTO 10280,10360,10460 10280 GOSUB 10540 10300 GOSUB 10780 10320 GOSUB 14500 10340 GOTO 10120 10360 REM ***** 10380 GOSUB 10540 10400 GOSUB 15600 10420 GOSUB 16420 10440 GOTO 10120 10460 GOSUB 10540 10480 GOSUB 15600 10500 GOSUB 17760 10520 GOTO 10120 10540 GOSUB 500 10560 PRINT "********** WHICH FILE DO YOU WANT ************" 10580 PRINT "" 10600 FOR A = 1 TO MAXF 10620 PRINT A;" - "; F$(A) 10640 NEXT A 10660 PRINT "" 10680 PRINT "******** ENTER THE NUMBER THEN RETURN ********" 10690 MAX = 2 10700 GOSUB 62030 10710 AH$ = A$ 10720 A = VAL(A$) 10730 IF A = 0 THEN A = 1 10735 IF A = 1 THEN AH$ = "1" 10740 IF A<1 OR A> MAXF GOTO 10700 10760 RETURN 10780 FOR N = 1 TO NREC(A) 10800 GOSUB 500 10820 GOSUB 10900 10840 GOSUB 11380 10860 NEXT N 10880 RETURN 10900 GOSUB 500 10920 PRINT "FIELD # ";N;" ";FLDN$(A,N) 10940 IF FTY(A,N) = 1 THEN PRINT " STRING WITH MAXIMUM LENGTH ";FL(A,N) 10960 IF FTY(A,N) = 2 THEN PRINT " INTEGER" 10980 IF FTY(A,N) = 3 THEN PRINT " SINGLE PRECISION " 11000 IF FTY(A,N) = 4 THEN PRINT " DOUBLE PRECISION " 11020 IF FTY(A,N) = 5 THEN PRINT " DOLLARS AND CENTS AMOUNT" 11040 PRINT "---------------------------------------------------------" 11060 PRINT "****** WHAT TYPE OF INPUT DO YOU WANT FOR THIS FIELD ******" 11080 PRINT " 1 - OPERATOR ENTRY " 11100 PRINT " 2 - GET FROM ANOTHER FILE" 11120 PRINT " 3 - ADD SEVERAL PREVIOUS FIELDS **** NUMBERS ONLY ****" 11140 PRINT " 4 - SUBTRACT TWO PREVIOUS FIELDS '' '' '' '' " 11160 PRINT " 5 - MULTIPLY TWO PREVIOUS FIELDS" 11180 PRINT " 6 - COMPUTE USING TAX TABLE " 11200 PRINT " 7 - CONSTANT" 11220 PRINT " 8 - MAXIMUM OF PREVIOUS FIELDS" 11240 PRINT " 9 - MINIMUM OF PREVIOUS FIELDS" 11260 PRINT "10 - MULTIPLY BY A CONSTANT " 11280 PRINT "11 - ADD A CONSTANT" 11300 PRINT "12 - SUBTRACT A CONSTANT FROM A PREVIOUS FIELD" 11310 PRINT "13 - DIVIDE PREVIOUS FIELDS " 11320 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *************" 11340 GOSUB 60000 11342 IF DT# <1 GOTO 11340 11344 IF FTY(A,N) = 1 AND DT# > 2 GOTO 11340 11350 IOPT(N) = DT# 11360 ON IOPT(N) GOTO 11560,11640,12080,12320,12500,12680,14300,13820,14060,14300,14300,14300,12320 11370 RETURN 11380 PRINT "********** IS THE DATA YOU JUST ENTERED CORRECT ***********" 11400 PRINT " 1 - CORRECT" 11420 PRINT " 2 - NOT CORRECT" 11440 PRINT "************ ENTER THE NUMBER THEN PRESS RETURN ***********" 11460 GOSUB 60000 11462 IF DT# <1 OR DT#> 2 GOTO 11460 11470 D = DT# 11480 IF D = 2 GOTO 10900 11500 RETURN 11520 GOTO 11380 11540 GOTO 10320 11560 REM ***** OPERATOR ENTRY ***** 11580 PRINT "******************** OPERATOR ENTRY ******************" 11590 PRINT "The prompt will be displayed when the input is requested" 11600 PRINT "********* ENTER THE PROMPT THEN PRESS RETURN *********" 11605 MAX = 75 11610 GOSUB 62030 11615 PROMPT$(N) = A$ 11620 RETURN 11640 REM ****** GET FROM ANOTHER FILE ****** 11660 PRINT "*************** GET FROM ANOTHER FILE ***************" 11680 FOR F = 1 TO MAXF 11700 PRINT F;" - ";F$(F) 11720 NEXT F 11740 PRINT "****** WHICH FILE DO YOU WANT TO GET ENTRY FROM ******" 11750 PRINT "Must be the same file for all fields " 11760 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN *********" 11780 GOSUB 60000 11782 IF DT# <1 OR DT#> MAXF GOTO 11780 11784 IF HLD > 0 AND DT# >< HLD GOTO 11780 11785 IFN(N) = DT# 11787 HLD = DT# 11800 B = IFN(N) 11820 FOR T = 1 TO NREC(B) 11840 PRINT T;" - ";FLDN$(B,T) 11860 NEXT T 11880 PRINT "****** WHICH FIELD DO YOU WANT TO GET ENTRY FROM ******" 11900 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN **********" 11920 GOSUB 60000 11922 IF DT# <1 OR DT#> NREC(B) GOTO 11920 11930 IFLD(N) = DT# 11940 FOR T = 1 TO NREC(A) 11960 PRINT T;" - ";FLDN$(A,T) 11980 NEXT T 12000 PRINT "********** RECORD NUMBER EQUALS WHICH FIELD ***********" 12020 PRINT "******* ENTER THE FIELD NUMBER THEN PRESS RETURN ******" 12040 GOSUB 60000 12042 IF DT# <1 OR DT#> NREC(B) GOTO 12040 12050 IRNFLD(N) = DT# 12060 RETURN 12080 REM ***** ADD PREVIOUS FIELDS ***** 12090 X(5,N) = DT# 12100 PRINT "************* ADD PREVIOUS FIELDS ************" 12120 PRINT "***** HOW MANY FIELDS DO YOU WANT TO ADD *****" 12140 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****" 12145 GOSUB 60000 12147 IF DT# <1 OR DT#> NREC(A) GOTO 12145 12150 NOS(N) = DT# 12160 FOR T = 1 TO NREC(A) 12180 PRINT T;" - ";FLDN$(A,T) 12200 NEXT T 12220 FOR J = 1 TO NOS(N) 12240 PRINT "***** ENTER THE ";J;"th FIELD TO BE ADDED *****" 12260 GOSUB 60000 12262 IF DT# <1 OR DT#> NREC(A) GOTO 12260 12264 IF FTY(A,DT#) = 1 GOTO 12260 12270 ADDFLD(N,J) = DT# 12280 NEXT J 12300 RETURN 12320 REM ***** SUBTRACT FIELDS ***** 12340 IF IOPT(N) = 4 THEN PRINT "******** SUBTRACT FIELD X - FIELD Y *****" 12350 IF IOPT(N) = 13 THEN PRINT "******* DIVIDE FIELD X BY FIELD Y ********" 12360 FOR T = 1 TO NREC(A) 12380 PRINT T;" - ";FLDN$(A,T) 12400 NEXT T 12440 PRINT "***** ENTER FIELD X THEN PRESS RETURN *****" 12445 GOSUB 60000 12447 IF DT# <1 OR DT#> NREC(A) GOTO 12445 12448 IF FTY(A,DT#) = 1 GOTO 12445 12450 SUBX(N) = DT# 12460 PRINT "***** ENTER FIELD Y THEN PRESS RETURN *****" 12462 GOSUB 60000 12464 IF DT# <1 OR DT#> NREC(A) GOTO 12462 12465 SUBY(N) = DT# 12467 IF FTY(A,DT#) = 1 GOTO 12462 12480 RETURN 12500 REM ***** MULTIPY FIELDS ***** 12520 PRINT "************ MULTIPLY FIELDS *************" 12540 FOR T = 1 TO NREC(A) 12560 PRINT T;" - ";FLDN$(A,T) 12580 NEXT T 12600 PRINT "********** FIELD X TIMES FIELD Y **********" 12620 PRINT "***** ENTER FIELD X THEN PRESS RETURN *****" 12625 GOSUB 60000 12627 IF DT# <1 OR DT#> NREC(A) GOTO 12625 12628 IF FTY(A,DT#) = 1 GOTO 12625 12630 MULX(N) = DT# 12640 PRINT "***** ENTER FIELD Y THEN PRESS RETURN *****" 12645 GOSUB 60000 12647 IF DT# <1 OR DT#> NREC(A) GOTO 12645 12648 IF FTY(A,DT#) = 1 GOTO 12645 12650 MULY(N) = DT# 12660 RETURN 12680 REM ********* TAX COMPUTE ********* 12700 GOSUB 500 12720 PRINT "***************** IS THE TAX TABLE *****************" 12740 PRINT " 1 - CONSTANT " 12760 PRINT " 2 - VARIABLE " 12780 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN ********" 12782 IF DT# <1 OR DT#> 2 GOTO 12800 12800 GOSUB 60000 12802 IF DT# <1 OR DT#> 2 GOTO 12800 12810 X(1,N) = DT# 12820 ON X(1,N) GOSUB 13240,13380 12840 GOSUB 500 12860 PRINT "***************** IS THE PAY PERIOD *****************" 12880 PRINT " 1 - CONSTANT " 12900 PRINT " 2 - VARIABLE " 12920 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN *********" 12940 GOSUB 60000 12942 IF DT# <1 OR DT#> 2 GOTO 12940 12950 X(3,N) = DT# 12960 ON X(3,N) GOSUB 13540,13660 12980 PRINT "******* WHICH FIELD IS SINGLE / MARRIED FIELD ********" 13000 FOR T = 1 TO N 13020 PRINT T;"-";FLDN$(A,T) 13040 NEXT T 13060 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********" 13080 GOSUB 60000 13082 IF DT# <1 OR DT#> NREC(A) GOTO 13080 13084 IF FTY(A,DT#) = 1 GOTO 13080 13090 X(5,N) = DT# 13100 PRINT "*************** WHICH FIELD IS THE PAY ****************" 13120 FOR T = 1 TO N 13140 PRINT T;"-";FLDN$(A,T) 13160 NEXT T 13180 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********" 13200 GOSUB 60000 13202 IF DT# <1 OR DT#> NREC(A) GOTO 13200 13204 IF FTY(A,DT#) = 1 GOTO 13200 13210 X(6,N) = DT# 13220 RETURN 13240 REM ******* TAX TABLE = CONSTANT 13260 PRINT "*************** ENTER THE TABLE NUMBER ****************" 13280 PRINT "" 13300 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********" 13320 PRINT "" 13340 GOSUB 60000 13350 X(2,N) = DT# 13360 RETURN 13380 REM ******* TAX TABLE VARIABLE 13400 PRINT "********* WHICH FIELD CONTAINS THE TABLE NUMBER *******" 13420 FOR T = 1 TO N 13440 PRINT T;"-";FLDN$(A,T) 13460 NEXT T 13480 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ********" 13500 GOSUB 60000 13502 IF DT# <1 OR DT#> NREC(A) GOTO 13500 13510 X(2,N) = DT# 13520 RETURN 13540 REM ******* PAY PERIOD CONSTANT 13560 PRINT "************* ENTER THE PAY PERIOD CONSTANT ***********" 13580 PRINT "" 13600 PRINT "********** ENTER THE CONSTANT THEN PRESS RETURN *******" 13620 GOSUB 60000 13630 X(4,N) = DT# 13640 RETURN 13660 REM ******* PAY PERIOD VARIABLE 13680 PRINT "****** WHICH FIELD CONTAINS THE PAY PERIOD NUMBER *****" 13700 FOR T = 1 TO N 13720 PRINT T;"-";FLDN$(A,T) 13740 NEXT T 13760 PRINT "********** ENTER THE NUMBER THEN PRESS RETURN *********" 13780 GOSUB 60000 13782 IF DT# <1 OR DT#> NREC(A) GOTO 13780 13783 IF DT# = 1 GOTO 13780 13790 X(4,N) = DT# 13800 RETURN 13820 REM ************ MAXIMUM ************** 13840 PRINT "*************** MAXIMUM OF ITEMS ****************" 13860 PRINT "***** HOW MANY ITEMS DO YOU WANT TO COMPARE *****" 13880 GOSUB 60000 13890 NOS(N) = DT# 13900 FOR T = 1 TO NREC(A) 13920 PRINT T;" - ";FLDN$(A,T) 13940 NEXT T 13960 FOR J = 1 TO NOS(N) 13980 PRINT "****** ENTER THE ";J;"th ITEM TO BE COMPARED *****" 14000 GOSUB 60000 14002 IF DT# <1 OR DT#> NREC(A) GOTO 14000 14004 IF FTY(A,DT#) = 1 GOTO 14000 14010 MAXMIN(N,J) = DT# 14020 NEXT J 14040 RETURN 14060 REM ************ MINIMUM ************** 14080 PRINT "************** MINIMUM OF ITEMS ****************" 14100 PRINT "***** HOW MANY ITEMS DO YOU WANT TO COMPARE *****" 14120 GOSUB 60000 14130 NOS(N) = DT# 14140 FOR T = 1 TO NREC(A) 14160 PRINT T;" - ";FLDN$(A,T) 14180 NEXT T 14200 FOR J = 1 TO NOS(N) 14220 PRINT "***** ENTER THE ";J;"th ITEM TO BE COMPARED *****" 14240 GOSUB 60000 14242 IF DT# <1 OR DT#> NREC(A) GOTO 14240 14244 IF FTY(A,DT#) = 1 GOTO 14240 14250 MAXMIN(N,J) = DT# 14260 NEXT J 14280 RETURN 14300 REM *********** CONSTANT ************ 14320 PRINT "************** ENTER CONSTANT ****************" 14340 GOSUB 60180 14350 KC(N) = DT# 14360 IF IOPT(N) = 7 THEN RETURN 14380 FOR T = 1 TO NREC(A) 14400 PRINT T;" - ";FLDN$(A,T) 14420 NEXT T 14440 PRINT "********* WHAT FIELD IS OPERATED ON **********" 14460 GOSUB 60000 14462 IF DT# <1 OR DT#> NREC(A) GOTO 14460 14464 IF FTY(A,DT#) = 1 GOTO 14460 14470 CFLD(N) = DT# 14480 RETURN 14500 REM ********** OPEN IPUTD ********** 14520 GOSUB 500 14540 PRINT "************* WRITING DATA ON FILE ***************" 14560 N$ = "IPUTD" + AH$ 14580 OPEN "O",#1,N$ 14600 WRITE #1,NREC(A) 14620 FOR N = 1 TO NREC(A) 14640 WRITE #1,IOPT(N) 14660 ON IOPT(N) GOTO 14680,14740,14800,14940,15000,15060,15260,15140,15140,15260,15260,15260,14940 14680 REM ***** OPERATOR ENTRY ***** 14700 WRITE #1,PROMPT$(N) 14720 GOTO 15300 14740 REM ***** GET FROM ANOTHER FILE ***** 14760 WRITE #1,IFN(N),IFLD(N),IRNFLD(N) 14780 GOTO 15300 14800 REM ***** ADD PREVIOUS FIELDS ****** 14820 WRITE #1,NOS(N) 14840 FOR T = 1 TO NOS(N) 14860 Q = ADDFLD(N,T) 14880 WRITE #1,ADDFLD(N,T) 14900 NEXT T 14920 GOTO 15300 14940 REM ***** SUBTRACT PREVIOUS FIELDS ****** 14960 WRITE #1, SUBX(N),SUBY(N) 14980 GOTO 15300 15000 REM ***** MULTIPLY FIELDS ***** 15020 WRITE #1, MULX(N),MULY(N) 15040 GOTO 15300 15060 REM ***** TAX TABLE ***** 15080 WRITE #1,X(1,N),X(2,N),X(3,N),X(4,N),X(5,N),X(6,N) 15100 GOTO 15300 15120 WRITE #1,CMOPT(N) 15140 REM ***** MAXIMUM ****** 15160 WRITE #1,NOS(N) 15180 FOR T = 1 TO NOS(N) 15200 WRITE #1,MAXMIN(N,T) 15220 NEXT T 15240 GOTO 15300 15260 REM ***** CONSTANT ***** 15280 WRITE #1,KC(N),CFLD(N) 15300 NEXT N 15320 CLOSE #1 15340 RETURN 15600 REM ********** OPEN IPUTD ********** 15620 GOSUB 500 15640 PRINT "************* READING DATA FROM FILE ***************" 15660 N$ = "IPUTD" + A$ 15680 OPEN "I",#1,N$ 15700 INPUT #1,NREC(A) 15720 FOR N = 1 TO NREC(A) 15740 INPUT #1,IOPT(N) 15760 ON IOPT(N) GOTO 15780,15840,15900,16020,16080,16140,16320,16200,16200,16320,16320,16320,16020 15780 REM ***** OPERATOR ENTRY ***** 15800 INPUT #1,PROMPT$(N) 15820 GOTO 16360 15840 REM ***** GET FROM ANOTHER FILE ***** 15860 INPUT #1,IFN(N),IFLD(N),IRNFLD(N) 15880 GOTO 16360 15900 REM ***** ADD PREVIOUS FIELDS ****** 15920 INPUT #1,NOS(N) 15940 FOR T = 1 TO NOS(N) 15960 INPUT #1,ADDFLD(N,T) 15980 NEXT T 16000 GOTO 16360 16020 REM ***** SUBTRACT PREVIOUS FIELDS ****** 16040 INPUT #1, SUBX(N),SUBY(N) 16060 GOTO 16360 16080 REM ***** MULTIPLY FIELDS ***** 16100 INPUT #1, MULX(N),MULY(N) 16120 GOTO 16360 16140 REM ***** GET FROM A TABLE ***** 16160 INPUT #1,X(1,N),X(2,N),X(3,N),X(4,N),X(5,N),X(6,N) 16180 GOTO 16360 16200 REM ***** MAXIMUM ****** 16220 INPUT #1,NOS(N) 16240 FOR T = 1 TO NOS(N) 16260 INPUT #1,MAXMIN(N,T) 16280 NEXT T 16300 GOTO 16360 16320 REM ***** CONSTANT ***** 16340 INPUT #1,KC(N),CFLD(N) 16360 NEXT N 16380 CLOSE #1 16400 RETURN 16420 REM ********** PRINT IPUTD ********** 16460 GOSUB 500 16480 PRINT N$ 16500 FOR N = 1 TO NREC(A) 16520 PRINT "********** ";N;" ";FLDN$(A,N);" ************" 16540 PRINT " INPUT OPTION ";IOPT(N);" "; 16560 ON IOPT(N) GOTO 16580,16660,16800,16920,17020,17120,17620,17480,17480,17620,17620,17620,16920 16563 PRINT "" 16565 GOTO 17680 16580 REM ***** OPERATOR ENTRY ***** 16600 PRINT "OPERATOR ENTRY" 16620 PRINT "PROMPT ";PROMPT$(N) 16640 GOTO 17680 16660 REM ***** GET FROM ANOTHER FILE ***** 16680 PRINT "GET FROM ANOTHER FILE " 16690 PRINT "FROM FILE: FROM FIELD: SOURCE RECORD NUMBER IS THIS FIELDS VALUE:" 16700 Q=IFN(N) 16720 W = IFLD(N) 16740 Z = IRNFLD(N) 16760 PRINT F$(Q),TAB(15) FLDN$(Q,W),TAB(38) FLDN$(A,Z) 16780 GOTO 17680 16800 REM ***** ADD PREVIOUS FIELDS ****** 16820 PRINT "ADD PREVIOUS FIELDS #OF ADDS : ";NOS(N) 16840 FOR T = 1 TO NOS(N) 16860 PRINT "ADD THIS FIELD ";ADDFLD(N,T);FLDN$(A,Q) 16880 NEXT T 16900 GOTO 17680 16920 REM ***** SUBTRACT PREVIOUS FIELDS ****** 16940 Q = SUBX(N) 16960 W = SUBY(N) 16980 IF IOPT(N) = 4 THEN PRINT "SUBTRACT ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W) 16990 IF IOPT(N) = 13 THEN PRINT "DIVIDE ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W) 17000 GOTO 17680 17020 REM ***** MULTIPLY FIELDS ***** 17040 Q = MULX(N) 17060 W = MULY(N) 17080 PRINT "MULTIPLY "; MULX(N);FLDN$(A,Q);MULY(N);FLDN$(A,W) 17100 GOTO 17680 17120 REM ***** GET FROM A TABLE ***** 17140 ON X(1,N) GOSUB 17340,17280 17160 ON X(3,N) GOSUB 17440,17380 17180 Y = X(5,N) 17200 PRINT "SINGLE MARRIED FIELD NUMBER =";X(5,N);FLDN$(A,Y) 17220 Y = X(6,N) 17240 PRINT "PAY FIELD NUMBER = "X(6,N);FLDN$(A,Y) 17260 GOTO 17680 17280 Y = X(2,N) 17300 PRINT " TAX TABLE VARIES NUMBER = FIELD ";FLDN$(A,Y) 17320 RETURN 17340 PRINT "TAX TABLE CONSTANT NUMBER =";X(2,N) 17360 RETURN 17380 Y = X(4,N) 17400 PRINT "PAY PERIOD VARIES NUMBER = FIELD ";FLDN$(A,Y) 17420 RETURN 17440 PRINT "PAY PERIOD CONSTANT NUMBER = ";X(4,N) 17460 RETURN 17480 REM ***** MAXIMUM ****** 17500 PRINT "MAX OR MIN NUMBER OF ITMS";NOS(N) 17520 FOR T = 1 TO NOS(N) 17540 Q = MAXMIN(N,T) 17560 PRINT "COMPARE : ";MAXMIN(N,T);FLDN$(A,Q) 17580 NEXT T 17600 GOTO 17680 17620 REM ***** CONSTANT ***** 17640 Q = CFLD(N) 17660 PRINT "CONSTANT";KC(N);CFLD(N);FLDN$(A,Q) 17680 NEXT N 17700 PRINT "******* PRESS ANY KEY TO CONTINUE *******" 17720 IF INKEY$ = "" GOTO 17720 17740 RETURN 17760 REM ********** LPRINT IPUTD ********** 17800 GOSUB 500 17820 LPRINT N$ 17840 FOR N = 1 TO NREC(A) 17860 LPRINT "********** ";N;" ";FLDN$(A,N);" ************" 17880 LPRINT " INPUT OPTION ";IOPT(N);" "; 17900 ON IOPT(N) GOTO 17920,18000,18140,18260,18360,18460,18960,18820,18820,18960,18960,18960,18260 17905 LPRINT "" 17910 GOTO 19020 17920 REM ***** OPERATOR ENTRY ***** 17940 LPRINT "OPERATOR ENTRY" 17960 LPRINT "PROMPT ";PROMPT$(N) 17980 GOTO 19020 18000 REM ***** GET FROM ANOTHER FILE ***** 18020 LPRINT "GET FROM ANOTHER FILE " 18030 LPRINT "FROM FILE: FROM FIELD SOURCE RECORD NUMBER IS THIS FIELDS VALUE:" 18040 Q=IFN(N) 18060 W = IFLD(N) 18080 Z = IRNFLD(N) 18100 LPRINT F$(Q),TAB(15) FLDN$(Q,W),TAB(39) FLDN$(A,Z) 18120 GOTO 19020 18140 REM ***** ADD PREVIOUS FIELDS ****** 18160 LPRINT "ADD PREVIOUS FIELDS #OF ADDS : ";NOS(N) 18180 FOR T = 1 TO NOS(N) 18200 LPRINT "ADD THIS FIELD ";ADDFLD(N,T);FLDN$(A,Q) 18220 NEXT T 18240 GOTO 19020 18260 REM ***** SUBTRACT PREVIOUS FIELDS ****** 18280 Q = SUBX(N) 18300 W = SUBY(N) 18320 IF IOPT(N) = 13 THEN LPRINT "DIVIDE ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W) 18330 IF IOPT(N) = 4 THEN LPRINT "SUBTRACT ";SUBX(N);FLDN$(A,Q);SUBY(N);FLDN$(A,W) 18340 GOTO 19020 18360 REM ***** MULTIPLY FIELDS ***** 18380 Q = MULX(N) 18400 W = MULY(N) 18420 LPRINT "MULTIPLY "; MULX(N);FLDN$(A,Q);MULY(N);FLDN$(A,W) 18440 GOTO 19020 18460 REM ***** GET FROM A TABLE ***** 18480 ON X(1,N) GOSUB 18680,18620 18500 ON X(3,N) GOSUB 18780,18720 18520 Y = X(5,N) 18540 LPRINT "SINGLE MARRIED FIELD NUMBER =";X(5,N);FLDN$(A,Y) 18560 Y = X(6,N) 18580 LPRINT "PAY FIELD NUMBER = "X(6,N);FLDN$(A,Y) 18600 GOTO 19020 18620 Y = X(2,N) 18640 LPRINT " TAX TABLE VARIES NUMBER = FIELD ";FLDN$(A,Y) 18660 RETURN 18680 LPRINT "TAX TABLE CONSTANT NUMBER =";X(2,N) 18700 RETURN 18720 Y = X(4,N) 18740 LPRINT "PAY PERIOD VARIES NUMBER = FIELD ";FLDN$(A,Y) 18760 RETURN 18780 LPRINT "PAY PERIOD CONSTANT NUMBER = ";X(4,N) 18800 RETURN 18820 REM ***** MAXIMUM ****** 18840 LPRINT "MAX OR MIN NUMBER OF ITMS";NOS(N) 18860 FOR T = 1 TO NOS(N) 18880 Q = MAXMIN(N,T) 18900 LPRINT "COMPARE : ";MAXMIN(N,T);FLDN$(A,Q) 18920 NEXT T 18940 GOTO 19020 18960 REM ***** CONSTANT ***** 18980 Q = CFLD(N) 19000 LPRINT "CONSTANT";KC(N);CFLD(N);FLDN$(A,Q) 19020 NEXT N 19040 RETURN 23780 REM ************* READ SUBROUTINE ************* 23800 OPEN "I",#1,"FFILE" 23820 INPUT #1,MAXF 23840 FOR A = 1 TO MAXF 23860 INPUT #1,A,F$(A),NREC(A),L(A) 23880 FOR N = 1 TO NREC(A) 23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N) 23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N) 23940 NEXT N 23960 NEXT A 23980 CLOSE #1 24000 RETURN 50000 REM ********** INTRO 50010 GOSUB 500 50100 PRINT " I N P U T P R O G R A M 3.0 " 50105 PRINT "" 50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc." 50120 PRINT "" 50130 PRINT "This program is licensed FREE to all users with some restrictions" 50165 PRINT " See the manual for more information on the license." 50167 PRINT "" 50920 GOSUB 23780 50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *****************"; 50960 IF INKEY$ = "" GOTO 50960 50970 RETURN 51000 REM ***** EXIT TO SYSTEM 51100 GOSUB 500 51110 CLOSE 51120 PRINT " -BYE, Have a nice day" 51130 END 52000 REM ***** INTRO 1 52010 GOSUB 500 52100 PRINT " Put the DATA DISK in the default disk drive " 52110 PRINT "" 52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****" 52130 PRINT "" 52140 PRINT " The CUSTOM programs only use the PROGRAM DATA DISK" 52150 PRINT "Keep it in the default disk drive at all times during this program." 52200 IF INKEY$ = "" GOTO 52200 52210 RETURN 60000 REM ******* INTEGER LESS THEN 100 CHECK ******** 60010 MAX = 2 60020 ACT$ = "1234567890=<>^" 60030 IF NE = 0 THEN ACT$ = "1234567890" 60040 PRINT ">__<"; 60045 GOTO 60240 60050 REM 60060 REM ******* INTEGER ******* 60070 MAX = 8 60080 ACT$ = "1234567890-+,=<>^" 60090 IF NE = 0 THEN ACT$ = "1234567890-+," 60100 PRINT ">________<"; 60110 GOTO 60240 60120 REM ******* SINGLE PRECISION ******* 60130 MAX = 10 60140 ACT$ = "1234567890-+,.%$=<>^" 60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 60160 PRINT ">__________<"; 60170 GOTO 60240 60180 REM ******* DOUBLE PRECISION ******* 60190 MAX = 20 60200 ACT$ = "1234567890-+,.%$=<>^" 60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 60220 PRINT ">____________________<"; 60230 GOTO 60240 60240 REM ********** NUMBER CHECK ********** 60250 A$ = "" 60260 K$(20) = " " 60270 KTMAX = 0 60280 FOR T9 = 1 TO MAX 60290 K$(T9) = " " 60300 NEXT T9 60310 DIG$ = "1234567890." 60320 DOTFLG = 0 60330 T2 = MAX + 1 60340 FOR T6 = 1 TO T2 60350 PRINT CHR$(CH); 60360 NEXT T6 60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370 60380 KT = 0 60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH *********** 60400 KT = KT + 1 60410 REM 60420 W$ = INKEY$ 60430 IF W$ = "" GOTO 60420 60440 C = ASC(W$) 60450 IF C = 0 THEN GOSUB 61900 60460 IF C = 13 GOTO 60580 60470 IF C = 17 OR C = 8 GOTO 61150 60480 IF C = 19 GOTO 60670 60490 IF C = 4 GOTO 60720 60500 IF C = 6 GOTO 60780 60510 IF C = 1 GOTO 60960 60520 IF KT > MAX GOTO 60410 60530 IF INSTR(ACT$,W$) = 0 GOTO 61230 60540 K$(KT) = W$ 60550 PRINT K$(KT); 60560 IF KT > KTMAX THEN KTMAX = KT 60570 GOTO 60400 60580 REM ********** RETURN ********** 60590 FOR T9 = 1 TO KTMAX 60600 A$ = A$ + K$(T9) 60610 NEXT T9 60620 IF KTMAX = 0 THEN PRINT "1" 60630 IF KTMAX = 0 THEN DT# = 1 60640 IF KTMAX = 0 THEN RETURN 60650 PRINT "" 60660 GOTO 61260 60670 REM ********* MOVE CURSE BACK ******** 60680 IF KT = 1 GOTO 60410 60690 KT = KT - 1 60700 PRINT CHR$(CH); 60710 GOTO 60410 60720 REM ********* MOVE CURSER FORWARD ********* 60730 IF KT >= MAX GOTO 60410 60740 IF KT > (KTMAX + 1) GOTO 60410 60750 PRINT K$(KT); 60760 KT = KT + 1 60770 GOTO 60410 60780 REM ********** INSERT *********** 60790 IF KT > KTMAX GOTO 60410 60800 X9 = MAX 60810 WHILE X9 > KT 60820 X9 = X9 - 1 60830 K$(X9 + 1) = K$(X9) 60840 WEND 60850 K$(KT) = " " 60860 KTMAX = KTMAX + 1 60870 IF KTMAX > MAX THEN KTMAX = MAX 60880 FOR T9 = KT TO KTMAX 60890 PRINT K$(T9); 60900 NEXT T9 60910 T6 = (KTMAX - KT) + 1 60920 FOR T7 = 1 TO T6 60930 PRINT CHR$(CH); 60940 NEXT T7 60950 GOTO 60410 60960 REM ********** DELETE *********** 60970 IF KT > KTMAX GOTO 60410 60980 IF KTMAX = 1 GOTO 60410 60990 K$(MAX + 1) = "" 61000 X9 = KT 61010 WHILE X9 <= MAX 61020 K$(X9) = K$(X9 + 1) 61030 X9 = X9 + 1 61040 WEND 61050 KTMAX = KTMAX - 1 61060 FOR T9 = KT TO KTMAX 61070 PRINT K$(T9); 61080 NEXT T9 61090 PRINT "_"; 61100 T7 = (KTMAX - KT) + 2 61110 FOR T8 = 1 TO T7 61120 PRINT CHR$(CH); 61130 NEXT T8 61140 GOTO 60410 61150 REM ********* BACKSPACE ******** 61160 IF KT = 1 GOTO 60410 61170 KT = KT - 1 61180 PRINT CHR$(CH); 61190 K$(KT) = " " 61200 PRINT "_"; 61210 PRINT CHR$(CH); 61220 GOTO 60410 61230 REM ******* INPUT NOT ACCEPTABLE ******** 61240 PRINT CHR$(7); 61250 GOTO 60420 61260 REM ********* CLEAR STRINGS ******** 61270 MAX = LEN(A$) 61280 D2$ = "" 61290 D1$ = "" 61300 DFLG = 0 61310 FOR Q93 = 1 TO MAX 61320 R$ = MID$(A$,Q93,1) 61330 IF INSTR(DIG$,R$) = 0 GOTO 61400 61340 IF R$ = "." OR DFLG = 1 GOTO 61380 61350 IF DFLG = 1 GOTO 61380 61360 D2$ = D2$ + R$ 61370 GOTO 61400 61380 D1$ = D1$ + R$ 61390 DFLG = 1 61400 NEXT Q93 61410 DA# = VAL(D2$) 61420 D1# = VAL(D1$) 61430 DT# = DA# + D1# 61440 IF K$(1) = "-" THEN DT# = -DT# 61450 RETURN 61900 REM ****** CHECK FOR ASC0 61910 S4$ = INKEY$ 61920 C2 = ASC(S4$) 61930 IF C2 = 83 THEN C = 1 61940 IF C2 = 82 THEN C = 6 61950 IF C2 = 75 THEN C = 19 61960 IF C2 = 77 THEN C = 4 61970 RETURN 62000 REM ********** ALPHANUMERIC CHECK ************** 62010 MAX = FL(A,Q) 62020 GOTO 62040 62030 REM ******** MAX SET IN PROGRAM ******** 62040 A$ = "" 62050 PRINT ">"; 62060 FOR N9 = 1 TO MAX 62070 K$(N9) = "" 62080 PRINT "_"; 62090 NEXT N9 62100 PRINT "<"; 62110 T2 = MAX + 1 62120 FOR T4 = 1 TO T2 62130 PRINT CHR$(CH); 62140 NEXT T4 62150 KT = 0 62160 KTMAX = 1 62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH *********** 62180 KT = KT + 1 62190 PRINT TAB(KT+1)""; 62200 K$ = INKEY$ 62210 IF K$ = "" GOTO 62200 62220 C = ASC(K$) 62230 IF C = 0 THEN GOSUB 61900 62240 IF C = 13 GOTO 62350 62250 IF C = 17 OR C = 8 GOTO 62920 62260 IF C = 19 GOTO 62450 62270 IF C = 4 GOTO 62500 62280 IF C = 6 GOTO 62560 62290 IF C = 1 GOTO 62730 62300 IF KT > MAX GOTO 62190 62310 K$(KT) = K$ 62320 PRINT K$(KT); 62330 IF KT > KTMAX THEN KTMAX = KT 62340 GOTO 62180 62350 REM ********** RETURN ********** 62360 FOR T9 = 1 TO MAX 62370 A$ = A$ + K$(T9) 62420 NEXT T9 62430 PRINT "" 62440 RETURN 62450 REM ********* MOVE CURSE BACK ******** 62460 IF KT = 1 GOTO 62190 62470 KT = KT - 1 62480 PRINT CHR$(CH); 62490 GOTO 62190 62500 REM ********* MOVE CURSER FORWARD ********* 62510 IF KT >= MAX GOTO 62190 62520 IF KT > KTMAX GOTO 62190 62530 PRINT K$(KT); 62540 KT = KT + 1 62550 GOTO 62190 62560 REM ********** INSERT *********** 62570 X9 = MAX 62580 WHILE X9 > KT 62590 X9 = X9 - 1 62600 K$(X9 + 1) = K$(X9) 62610 WEND 62620 K$(KT) = " " 62630 KTMAX = KTMAX + 1 62640 IF KTMAX > MAX THEN KTMAX = MAX 62650 FOR T9 = KT TO KTMAX 62660 PRINT K$(T9); 62670 NEXT T9 62680 T6 = (KTMAX - KT) +1 62690 FOR T7 = 1 TO T6 62700 PRINT CHR$(CH); 62710 NEXT T7 62720 GOTO 62190 62730 REM ********** DELETE *********** 62740 IF KT > KTMAX GOTO 62200 62750 IF KTMAX = 1 GOTO 62190 62760 K$(MAX + 1) = "" 62770 X9 = KT 62780 WHILE X9 <= KTMAX 62790 K$(X9) = K$(X9 + 1) 62800 X9 = X9 + 1 62810 WEND 62820 KTMAX = KTMAX - 1 62830 FOR T9 = KT TO KTMAX 62840 PRINT K$(T9); 62850 NEXT T9 62860 PRINT "_"; 62870 T7 = (KTMAX - KT) + 2 62880 FOR T6 = 1 TO T7 62890 PRINT CHR$(CH); 62900 NEXT T6 62910 GOTO 62190 62920 REM ********* BACKSPACE ******** 62930 IF KT = 1 GOTO 62190 62940 K$(KT) = " " 62950 KT = KT - 1 62960 K$(KT) = " " 62970 PRINT CHR$(CH); 62980 PRINT "_"; 62990 PRINT CHR$(CH); 63000 GOTO 62190 " " 62950 KT = KT - 1 62960 K$(KT) = " " 62970 PRINT CHR$(CH);